home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / tjgold.zip / INSTALL.001 / GOLDMENU.PAS < prev    next >
Pascal/Delphi Source File  |  1995-07-12  |  71KB  |  2,358 lines
  1. {--------------------------------------------------------------------------}
  2. {                Product: TechnoJock's Turbo Toolkit                       }
  3. {                Version: GOLD                                             }
  4. {                Build:   1.01                                             }
  5. {                                                                          }
  6. {                Copyright 1986-1995  TechnoJock Software, Inc.            }
  7. {                           All Rights Reserved                            }
  8. {                          Restricted by License                           }
  9. {--------------------------------------------------------------------------}
  10.  
  11.                     {**********************************}
  12.                     {**       Unit:   GOLDMENU       **}
  13.                     {**********************************}
  14.  
  15. {++++++++++++++++++++++++++++++} unit GOLDMENU; {++++++++++++++++++++++++++++}
  16.  
  17. {$I GOLDFLAG.INC}
  18. {$IFNDEF GOLDMENU}
  19.    {$DEFINE GOLDMENU}
  20. {$ENDIF}
  21.  
  22. {++++++++++++++++++++++++++++++++} INTERFACE {+++++++++++++++++++++++++++++++}
  23.  
  24. uses DOS, CRT, GoldAttr, GoldTint, GoldHard, GoldMisc, GoldKey,
  25.      GoldFast, GoldStr, GoldWin;
  26.  
  27. const
  28.    MaxChoices = 30;
  29.    MenuStrLength = 40;     {make longer if necessary}
  30.    NoChange: string[3] = '@#$';
  31.  
  32. type
  33.    XPackedWord = record
  34.       X1: byte;
  35.       X2: byte;
  36.    end;
  37.  
  38.    MenuHook = procedure(var Key:word; Choice:integer; var Ecode:integer);
  39.    MenuHindHook = procedure(Choice:integer; var Ecode:integer);
  40.  
  41.    MenuRecord = record
  42.       Heading1     : string[MenuStrLength];   {'' for no heading}
  43.       Heading2     : string[MenuStrLength];
  44.       Topic        : array[1..MaxChoices] of string[MenuStrLength];
  45.       TotalPicks   : integer;
  46.       PicksPerLine : byte;
  47.       AddPrefix    : byte;                    {0 no, 1 No.'s, 2 Lets}
  48.       TopLeftXY    : array[1..2] of byte;     {X,Y}
  49.       Boxtype      : byte;                    {0,1,2,3, >3}
  50.       Colors       : array[1..5] of byte;
  51.       Margins      : byte;
  52.       AllowEsc     : boolean;                 {true if Esc will exit}
  53.       Hook         : Menuhook;
  54.       HindHook     : MenuHindHook;
  55.    end; {MenuRecord}
  56.  
  57.    {Pull down declarations follow}
  58.  
  59.    PullHook = procedure (ID: integer);
  60.  
  61.    PopUpPtr = ^PopUp;
  62.  
  63.    PullItemPtr = ^PullItem;
  64.    PullItem = record
  65.       ID: integer;      {id returned by menu idenitifying user selection}
  66.       Topic: ^string;
  67.       LongDesc: ^string;
  68.       HK: word;         {hotkey}
  69.       AHK: word;        {alternate hotkey}
  70.       Active: boolean;
  71.       Status: word;     {used for different purposes based upon menu type}
  72.       Toggle: boolean;
  73.       ChildPopUp: PopUpPtr;
  74.       NextPtr: PullItemPtr;
  75.    end; {PullItem}
  76.  
  77.    PopUp = record
  78.       ActiveItem: byte;
  79.       Width: byte;
  80.       {internal}
  81.       ItemCount: byte;
  82.       X1,Y1,X2,Y2: integer;
  83.       FirstItem: PullItemPtr;
  84.    end; {PopUp}
  85.  
  86.    ChainItemPtr = ^ChainItem;
  87.    ChainItem = record
  88.       PopUp: PopUpPtr;
  89.       NextPtr: ChainItemPtr;
  90.    end;
  91.  
  92.    HKPtr = ^HK;
  93.    HK = record
  94.       HK: word;
  95.       ID: integer;
  96.       NextPtr: HKPtr;
  97.    end;
  98.  
  99.    BarPtr = ^Bar;
  100.    Bar = record
  101.       TopX: byte;
  102.       TopY: byte;
  103.       DescX1: byte;
  104.       DescX2: byte;
  105.       DescY: byte;
  106.       Style: byte;
  107.       ActiveItem: word;
  108.       EraseFullLine: boolean;
  109.       {internal - do not access directly}
  110.       MainX2: byte;
  111.       MainY: byte;
  112.       MainCount: byte;
  113.       ActiveChain: ChainItemPtr;   {list of all menus on display}
  114.       FirstItem: PullItemPtr;
  115.       HKs: HKPtr;        {hot keys that immeditaly return a menu selection}
  116.       MenuDown: boolean;
  117.       MsgDisplayed: boolean;
  118.       HelpHook: PullHook;
  119.       HelpActive: boolean;
  120.       HelpKey: word;
  121.       HelpMargin: byte;
  122.       HindHook: PullHook;
  123.    end; {Bar}
  124.  
  125.    MenuSetRec = record
  126.       LastECode: integer;
  127.       EMsgFunc: ErrMsgFunc;
  128.       MenuLeft: string[1];
  129.       MenuRight: string[1];
  130.       PullLeft: string[1];
  131.       PullRight: string[1];
  132.       PullSubIndicator: string[1];
  133.       InactiveChar: char;
  134.       TabChar: char;
  135.       ToggleChar: char;
  136.       ActivateKey: word;
  137.       Separator: string[1];
  138.       PullStyle: byte;
  139.       MsgX1: byte;
  140.       MsgX2: byte;
  141.       MsgY: byte;
  142.       HelpStr: string[20];
  143.       Helpkey: word;
  144.    end;  {MenuSetRec}
  145.  
  146. function  LastMenuError: integer;
  147. procedure NoHook(var Key:word; Choice:integer; var Ecode: integer);
  148. {Standard menu windows}
  149. procedure MenuSet(var M: Menurecord);
  150. procedure DisplayMenu(MenuDef: Menurecord; Window:Boolean; var Choice,Errorcode: integer);
  151. {Pulldown menu creation}
  152. procedure InitBar(var P: Bar);
  153. procedure InitPopup(var M:PopUp);
  154. procedure BarAddItem(var M: Bar; Item:string; ID:integer; HK,AltHK:word; Desc:string; PopUp:pointer);
  155. procedure PopupAddItem(var P:PopUp;Item:string; ID:integer; HK:word; Desc:string; ChildMenu:pointer);
  156. procedure BarAddHK(var P: Bar; K:word; HotID:integer);
  157. {changing menu settings}
  158. procedure BarSetActive(var M: Bar; ID:integer; On: boolean);
  159. procedure BarChangeItem(var M: Bar; Item:string; ID,NewID:integer; HK,AltHK:word; Desc:string; PopUp:pointer);
  160. procedure BarChangeText(var M: Bar; ID:integer; Item,Desc:string);
  161. procedure BarDelItem(var M: Bar; ID:integer);
  162. procedure BarDelHK(var P: Bar; K:word);
  163. procedure PopUpSetActive(var P:PopUp; ID:integer; On: boolean);
  164. procedure PopupChangeItem(var P:PopUp;Item:string; ID,NewID:integer; HK:word; Desc:string; ChildMenu:pointer);
  165. procedure PopUpChangeText(var P:PopUp; ID:integer; Item,Desc:string);
  166. procedure PopUpDelItem(var P:PopUp; ID:integer);
  167. {menu display and activation}
  168. procedure DrawBar(var M: Bar);
  169. function  ActivatePullMenu(var P: Bar): integer;
  170. function  IsPullKey(var P: Bar; K:word; X,Y:byte):boolean;
  171. function  PullPushKey(var M: Bar; K:word; X,Y:byte): integer;
  172. {hooks}
  173. procedure NoPullHook(ID:integer);
  174. procedure AssignMenuHelpHook(var M: Bar; Proc:PullHook);
  175. procedure AssignMenuHindHook(var M: Bar; Proc:PullHook);
  176. procedure RemoveMenuHelpHook(var M: Bar);
  177. procedure RemoveMenuHindHook(var M: Bar);
  178. {menu disposal}
  179. procedure DestroyBar(M:Bar);
  180. procedure DestroyPopUp(P:PopUp);
  181. {$IFDEF TTT5}
  182. procedure Menu_Set(var M: Menurecord);
  183. procedure Display_Menu(MenuDef: Menurecord; Window:Boolean; var Choice,Errorcode: integer);
  184. {$ENDIF}
  185.  
  186. var
  187.    MenuVars: MenuSetRec;
  188.  
  189. {+++++++++++++++++++++++++++++} IMPLEMENTATION {+++++++++++++++++++++++++++++}
  190. const
  191.   GPullLeft = -10;
  192.   GPullRight = -11;
  193.  
  194.                       {******************************}
  195.                       {**  Miscellaneous Routines  **}
  196.                       {******************************}
  197.  
  198. {$IFOPT F-}
  199.    {$DEFINE FOFF}
  200.    {$F+}
  201. {$ENDIF}
  202. procedure NoPullHook(ID:integer);
  203. {}
  204. begin
  205. end; { NoPullHook }
  206.  
  207. procedure NoHook(var Key:word; Choice:integer; var Ecode: integer);
  208. {}
  209. begin
  210. end; {NoHook}
  211.  
  212. procedure NoHindHook(Choice:integer; var Ecode:integer);
  213. {}
  214. begin
  215. end; {NoHindHook}
  216. {$IFDEF FOFF}
  217.    {$F-}
  218.    {$UNDEF FOFF}
  219. {$ENDIF}
  220.  
  221. {$IFOPT F-}
  222.    {$DEFINE FOFF}
  223.    {$F+}
  224. {$ENDIF}
  225. function MenuEMsg(ECode:integer): string;
  226. {}
  227. begin
  228.    case Ecode of
  229.       0: exit;
  230.       1001: MenuEMsg := 'Too Many Picks to display. Change PicksPerLine';
  231.       1002: MenuEMsg := 'Insufficient memory to create Pull Menu';
  232.       1003: MenuEMsg := 'Unable to change Menu item -- ID not found';
  233.       else
  234.          MenuEMsg := 'Internal Menu error';
  235.    end; {case}
  236. end; { MenuEMsg }
  237. {$IFDEF FOFF}
  238.    {$F-}
  239.    {$UNDEF FOFF}
  240. {$ENDIF}
  241.  
  242. procedure MenuSetError(ECode:integer);
  243. {}
  244. {$IFOPT D+}
  245. var Msg: string;
  246. {$ENDIF}
  247. begin
  248.    MenuVars.LastEcode := ECode;
  249. {$IFOPT D+}  {if debug active display an error message and terminate}
  250.    if Ecode <> 0 then
  251.    begin
  252.       str(Ecode,Msg);
  253.       Msg := Msg+': '+MenuVars.EMsgFunc(Ecode);
  254.       SetWinIgnore(true);
  255.       if PromptCustom(' GoldMenu Error ',Msg,' ~I~gnore ',' ~A~bort ','',279,286,0,0, 10000) = 2 then
  256.          Halt;
  257.    end;
  258. {$ENDIF}
  259. end; {MenuSetError}
  260.  
  261. function LastMenuError: integer;
  262. {}
  263. begin
  264.    LastMenuError := MenuVars.LastECode;
  265. end; { LastMenuError }
  266.  
  267. procedure MenuSet(var M: Menurecord);
  268. {}
  269. begin
  270.    with M do
  271.    begin
  272.       Heading1     := '';
  273.       Heading2     := '';
  274.       Topic[1]     := '';
  275.       TotalPicks   := 0;
  276.       PicksPerLine := 1;
  277.       AddPrefix    := 1;
  278.       TopLeftXY[1] := 0;
  279.       TopLeftXY[2] := 0;
  280.       Boxtype      := 5;
  281.       Colors[1]    := Tint[MenuHiHot];
  282.       Colors[2]    := Tint[MenuHi];
  283.       Colors[3]    := Tint[MenuNormHot];
  284.       Colors[4]    := Tint[MenuNorm];
  285.       Colors[5]    := Tint[MenuBorder];
  286.       Margins      := 5;
  287.       AllowEsc     := true;
  288.       Hook         := NoHook;
  289.       HindHook     := NoHindHook;
  290.    end;
  291. end; {MenuSet}
  292.  
  293. procedure DisplayMenu(MenuDef: Menurecord;
  294.                       Window:Boolean;
  295.                       var Choice,Errorcode : integer);
  296. Const
  297. Alphabet = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  298. Numbers  = '123456789';
  299. var
  300.    I,J,X2,Y2,headingLines: integer;
  301.    TextWidth: byte;
  302.    Ecode: integer;
  303.  
  304.    procedure GetDimensions;
  305.    var Fullwidth,MaxWidth: integer;
  306.  
  307.      procedure ValidatePrefix;
  308.      {
  309.           0   no prefix
  310.           1   numbers prefix
  311.           2   letters prefix
  312.           3   function key prefix
  313.           4   capital letter selection
  314.      }
  315.      begin
  316.         with MenuDef do
  317.         begin
  318.            if PicksPerLine < 1 then PicksPerLine := 1;
  319.            if (TotalPicks = 10) and (AddPrefix = 1) then
  320.               AddPrefix := 3;
  321.            if (TotalPicks > 10) and (AddPrefix in [1,3]) then
  322.               AddPrefix := 2;
  323.            if (Addprefix > 4) or (TotalPicks > 26) or (Addprefix < 0) then
  324.               Addprefix := 0;
  325.         end; {do}
  326.      end; { ValidatePrefix }
  327.  
  328.      procedure AddPrefix;
  329.      {}
  330.      var I: integer;
  331.      begin
  332.         with MenuDef do
  333.         begin
  334.            case AddPrefix of
  335.               1: for I := 1 to TotalPicks do
  336.                      if Topic[I][1] = '-' then
  337.                         insert(inttostr(I)+' ',Topic[I],2)
  338.                      else if Topic[I] <> '' then
  339.                         Topic[I] := '~'+inttostr(I)+'~' + ' ' + Topic[I];
  340.               2: for I := 1 to TotalPicks do
  341.                      if Topic[I][1] = '-' then
  342.                         insert(Copy(Alphabet,I,1)+' ',Topic[I],2)
  343.                      else if Topic[I] <> '' then
  344.                         Topic[I] := '~'+Copy(Alphabet,I,1)+'~' + ' ' + Topic[I];
  345.               3: for I := 1 to TotalPicks do
  346.                     if Topic[I][1] = '-' then
  347.                        insert('F'+InttoStr(I)+' '+copy(' ',1,ord(TotalPicks=10)),Topic[I],2)
  348.                     else if Topic[I] <> '' then
  349.                        Topic[I] := '~F'+InttoStr(I)+'~' + ' ' +copy(' ',1,ord(TotalPicks=10))+ Topic[I]
  350.            end; {case}
  351.         end;  {do}
  352.      end;  { AddPrefix }
  353.  
  354.      procedure FindLongestTopic;
  355.      {}
  356.      var
  357.         I,J: integer;
  358.         L:byte;
  359.      begin
  360.         with MenuDef do
  361.         begin
  362.            Textwidth := 0;
  363.            for I := 1 to TotalPicks do
  364.            begin
  365.               L := length(strip('A',HiMarker,Topic[I])) - ord((Topic[I] <> '') and (Topic[I] = '-'));
  366.               if L > TextWidth then
  367.                  Textwidth := L;         {find the longest text}
  368.            end;
  369.         end;
  370.      end; { FindLongestTopic }
  371.  
  372.      procedure AdjustTextWidth(Len: integer);
  373.      {}
  374.      var
  375.        I,J : integer;
  376.        L: byte;
  377.      begin
  378.         with MenuDef do
  379.         begin
  380.            for I := 1 to TotalPicks do
  381.            begin
  382.               L := length(strip('A',HiMarker,Topic[I]));
  383.               if L > Len then         {reduce it}
  384.                  delete(Topic[I],succ(Len),255)
  385.               else if L <> 0 then     {expand it}
  386.                  for J := succ(L) to Textwidth do
  387.                      Topic[I] :=  Topic[I] + ' ';
  388.            end;
  389.         end; {do}
  390.      end; { AdjustTextWidth }
  391.  
  392.      procedure DetermineMaxWidth;
  393.      {findout the max internal menu space - MaxWidth}
  394.      begin
  395.         with MenuDef do
  396.         begin
  397.            if Margins < 0 then
  398.               Margins := 0;
  399.            if not (BoxType in [0..9]) then
  400.               BoxType := 0;
  401.            MaxWidth := 80 - 2*Margins - 1; {-1 for arrow symbol to left of pick}
  402.            case BoxType of
  403.               1..4: MaxWidth := MaxWidth - 2;     {box sides}
  404.               5   : MaxWidth := pred(MaxWidth);   {box shadow}
  405.               6..9: MaxWidth := MaxWidth - 3;     {box sides and shadow}
  406.            end;
  407.         end;
  408.      end; { DetermineMaxWidth }
  409.  
  410.      procedure ValidatePicksPerLine;
  411.      {}
  412.      begin
  413.         with MenuDef do
  414.         begin
  415.            if succ(TextWidth)*PicksPerLine <= MaxWidth then
  416.               exit;  {no adjustment necessary, everything fits}
  417.            if (TextWidth-2)*PicksPerLine <= Maxwidth  then
  418.               TextWidth := pred(MaxWidth div PicksperLine)
  419.            else
  420.            begin
  421.               while succ(TextWidth)*PicksPerLine > MaxWidth do
  422.                     PicksPerLine := pred(PicksPerLine);
  423.               if PicksPerLine = 0 then
  424.               begin
  425.                  TextWidth := pred(MaxWidth);
  426.                  PicksPerLine := 1;
  427.               end;
  428.            end;
  429.         end; {with}
  430.      end;  { ValidatePicksPerLine }
  431.  
  432.      procedure DetermineXDimensions;
  433.      {Checks to see if the menu will fit, if it won't it changes something!}
  434.      begin
  435.         with MenuDef do
  436.         begin
  437.            Fullwidth := succ(Textwidth)*PicksPerLine + 2*Margins;
  438.            case BoxType of
  439.               1..4 : FullWidth := FullWidth + 2;     {box sides}
  440.               5    : FullWidth := succ(FullWidth);   {box shadow}
  441.               6..9 : FullWidth := FullWidth + 3;     {box sides and shadow}
  442.            end; {case}
  443.            if TopleftXY[1] < 1 then
  444.               TopleftXY[1] := (80 - Fullwidth)  div 2;
  445.            if TopLeftXY[1] + Fullwidth < 80 then
  446.               X2 := TopleftXY[1] + Fullwidth
  447.            else
  448.            begin
  449.               X2 := 80;
  450.               TopLeftXY[1] := 80 - Fullwidth + 1;
  451.            end;
  452.         end; {with}
  453.      end; { DetermineXDimensions }
  454.  
  455.      procedure DetermineYDimensions;
  456.      {}
  457.      var BoxLines,
  458.          TopicLines,
  459.          FullDepth: integer;
  460.      begin
  461.         with MenuDef do
  462.         begin
  463.            TopicLines := TotalPicks div PicksPerLine;  {no of full rows of picks}
  464.            if TotalPicks mod PicksPerLine > 0 then     {+1 if partial row of picks}
  465.               TopicLines := succ(TopicLines);
  466.            case BoxType of
  467.               0   : Boxlines := 0;
  468.               1..5: BoxLines :=  2;     {box sides}
  469.               6..9: BoxLines :=  3;     {box sides and shadow}
  470.            end;
  471.            HeadingLines := 0;
  472.            if length(Heading1) > 0 then
  473.               HeadingLines := succ(HeadingLines);
  474.            if length(Heading2) > 0 then
  475.               HeadingLines := succ(HeadingLines);
  476.            if HeadingLines > 0 then                   {add a line for a gap}
  477.               HeadingLines := succ(HeadingLines);    {gap above topics}
  478.            if BoxType = 5 then
  479.               HeadingLines := succ(HeadingLines);
  480.            Fulldepth := BoxLines+TopicLines+HeadingLines;
  481.            if HeadingLines > 0 then
  482.               Fulldepth := succ(Fulldepth);  {+1 gap below topics if headings}
  483.            if FullDepth > HardVars.Depth then   {if it doesn't fit, drop off topics}
  484.            begin
  485.               if HeadingLines > 0 then
  486.                  TotalPicks :=  (HardVars.Depth - BoxLines -HeadingLines-1)*PicksPerLine
  487.               else
  488.                  TotalPicks :=  (HardVars.Depth - BoxLines - HeadingLines)*PicksPerLine;
  489.               FullDepth := 25;
  490.            end;
  491.            if TopLeftXY[2] <= 0 then
  492.               TopLeftXY[2] := (HardVars.Depth - Fulldepth) div 2 +1;
  493.            if TopLeftXY[2] + Fulldepth - 1 <= HardVars.Depth then
  494.            begin
  495.               if BoxType > 4 then   {shadow}
  496.                  Y2 := TopleftXY[2] + (Fulldepth) - 2
  497.               else
  498.                  Y2 := TopleftXY[2] + pred(Fulldepth);
  499.            end else
  500.            begin
  501.               if BoxType > 4 then   {shadow}
  502.                  Y2 := pred(HardVars.Depth)
  503.               else
  504.                  Y2 := HardVars.Depth;
  505.               TopLeftXY[2] := HardVars.Depth - Fulldepth {+ 1};   {WZ}
  506.            end;
  507.         end;
  508.      end; { DetermineYDimensions }
  509.  
  510.    begin    { GetDimensions }
  511.       ValidatePrefix;
  512.       AddPrefix;
  513.       FindLongestTopic;
  514.       DetermineMaxWidth;
  515.       ValidatePicksPerLine;
  516.       AdjustTextWidth(TextWidth);
  517.       DetermineXDimensions;
  518.       DetermineYDimensions;
  519.    end;   { GetDimensions }
  520.  
  521.    procedure WriteText(Item:integer;Highlight:boolean);
  522.    {}
  523.    var X,Y,A: integer;
  524.    begin
  525.       with MenuDEf do
  526.       begin
  527.          A := Item mod PicksPerLine;
  528.          Y := Item div PicksPerLine +TopleftXY[2] + ord(A <> 0);
  529.          Y := Y + Headinglines - ord(Boxtype = 0);
  530.          if A = 0 then A := PicksPerLine;      {A is now the no of picks from left}
  531.          X := (A - 1)*(TextWidth + 1)+Margins+
  532.               TopleftXY[1]+1 + ord(BoxType > 0);          {title width + 1 for a space}
  533.          if Highlight then
  534.          begin
  535.             WriteHi(X,Y,colors[1],colors[2],Topic[item]);
  536.             WriteAT(pred(X),Y,colors[1],MenuVars.MenuLeft);  {write arrow head}
  537.             WriteAT(X+TextWidth,Y,colors[1],MenuVars.MenuRight);  {write arrow head}
  538.          end else
  539.          begin
  540.             if Topic[item] <> '' then
  541.             begin
  542.                if Topic[item][1] = '!' then  {inactive}
  543.                   WriteAt(pred(X),Y,Tint[MenuOff],' '+copy(Topic[item],2,255)+' ')
  544.                else
  545.                begin
  546.                   WriteHi(pred(X),Y,colors[3],colors[4],' '+Topic[item]+' ');       {remove arrow head}
  547.                   if AddPrefix = 4 then                             {highlight the capital letter}
  548.                      WriteAt(pred(X)+FirstCapitalPos(Topic[Item]),Y,
  549.                              colors[3],
  550.                              FirstCapital(Topic[Item]));
  551.                end;
  552.             end;
  553.          end;
  554.       end;
  555.    end;  { WriteText }
  556.  
  557.    procedure CreateMenu;
  558.    {}
  559.    var I: integer;
  560.    begin
  561.       with MenuDef do
  562.       begin
  563.          if Window then
  564.          begin
  565.             if BoxType <> 5 then
  566.                MkWin(TopleftXY[1],TopLeftXY[2],X2,Y2,colors[4],boxtype)
  567.             else
  568.                MkWin(TopleftXY[1],TopLeftXY[2],X2,Y2,colors[4],0);
  569.          end
  570.          else
  571.          begin
  572.             ClearText(TopleftXY[1],TopLeftXY[2],X2,Y2,colors[4]);
  573.             if (BoxType in [5..9]) and (TopleftXY[1] > 1) and not Window then
  574.                DrawShadow(TopLeftXY[1],TopLeftXY[2],X2,Y2);
  575.          end;
  576.          case Boxtype of
  577.             1..4: Box(TopLeftXY[1],TopLeftXY[2],X2,Y2,colors[5],Boxtype);
  578.             5   : begin
  579.               WriteAT(TopleftXY[1],TopleftXY[2],colors[5],
  580.                       replicate(succ(X2 - TopleftXY[1]),chr(223)));
  581.               WriteAT(TopleftXY[1],TopleftXY[2]+pred(HeadingLines),colors[5],
  582.                       replicate(succ(X2 - TopleftXY[1]),chr(196)));
  583.             end;
  584.             6..9: Box(TopLeftXY[1],TopLeftXY[2],X2,Y2,colors[5],Boxtype-5);
  585.          end; {case}
  586.          if length(Heading1) > 0 then
  587.              WriteBetween(TopleftXY[1],X2,
  588.                           TopLeftXY[2]+ord(BoxType > 0),
  589.                           colors[3],Heading1);
  590.          if length(Heading2) > 0 then
  591.             WriteBetween(TopleftXY[1],X2,
  592.                          TopLeftXY[2]+ord(BoxType > 0)+ord(HeadingLines <> 2),
  593.                          colors[3],Heading2);
  594.  
  595.          for I := 1 to TotalPicks do
  596.              WriteText(I,false);
  597.          WriteText(Choice,True);       {Highlight Default}
  598.       end; {do}
  599.    end; {CreateMenu}
  600.  
  601.    function TargetPick(X,Y:integer): byte;
  602.    {Returns the value of the menu pick}
  603.    var Pick,Col: byte;
  604.    begin
  605.       TargetPick := 0;
  606.       with MenuDef do
  607.       if (X >= TopLeftXY[1])
  608.       and (Y >= TopLeftXY[2])
  609.       and (X <= X2)
  610.       and (Y <= Y2) then
  611.       begin
  612.          dec(X,TopLeftXY[1]+ord(BoxType > 0));
  613.          dec(Y,TopLeftXY[2]+Headinglines+ord(Boxtype = 0));
  614.          Col := succ(X div (TextWidth + succ(Margins)));
  615.          if (Y > 0) and (Col > 0) and (Col <= PicksPerLine) then
  616.          begin
  617.             Pick := pred(Y)*PicksPerLine + Col;
  618.             if (Pick <= TotalPicks)
  619.             and (Topic[Pick] <> '')
  620.             and (Topic[Pick][1] <> '-')then
  621.                TargetPick := Pick;
  622.          end;
  623.       end;
  624.    end; { TargetPick }
  625.  
  626.    procedure ProcessMouse;
  627.    {}
  628.    var MouseChoice: byte;
  629.    begin
  630.       with KeyVars do
  631.          MouseChoice := TargetPick(LastX,LastY);
  632.       if not (MouseChoice in [0,Choice])then
  633.       begin
  634.          WriteText(Choice,false);
  635.          Choice := MouseChoice;
  636.          WriteText(Choice,true);
  637.       end;
  638.       MouseRelease;
  639.    end; { ProcessMouse }
  640.  
  641.    procedure ProcessKeystrokes;
  642.    {}
  643.    var Found,
  644.        Selected: Boolean;
  645.        WKey: word;
  646.        Oldchoice:integer;
  647.        I:integer;
  648.        P,ScanTop,ScanBot,Cx,Cy: byte;
  649.    begin
  650.       Selected := false;
  651.       Found := false;
  652.       CursorFind(Cx,Cy,ScanTop,ScanBot);
  653.       CursorOff;
  654.       with MenuDef do
  655.       begin
  656.          repeat
  657.             Oldchoice := Choice;
  658.             GetInput;
  659.             WKey := KeyVars.LastKey;
  660.             Hook(WKey,Choice,Ecode);   {call the user hook}
  661.             case Wkey of
  662.                336: begin       {Cursor Down}
  663.                   Writetext(Choice,false);
  664.                   repeat
  665.                      inc(Choice,PicksPerLine);
  666.                      if Choice > TotalPicks then
  667.                         Choice := (Choice mod PicksPerLine) + 1;
  668.                   until ((Topic[Choice] <> '') and (Topic[Choice][1] <> '-'))
  669.                      or (Choice = OldChoice);
  670.                   WriteText(Choice,true);
  671.                end;
  672.                328: begin       {cursor up}
  673.                   WriteText(Choice,false);
  674.                   repeat
  675.                      dec(Choice,PicksPerLine);
  676.                      if Choice < 1 then
  677.                      begin
  678.                         Choice := Choice + PicksPerline;
  679.                         Choice := ((TotalPicks div PicksPerLine)*PicksPerLine)
  680.                                     - PicksPerLine + 1 + Choice - 2;
  681.                         if Choice + PicksPerLine <= TotalPicks then
  682.                            inc(Choice,PicksPerLine);   {phew!}
  683.                   end;
  684.                   until ((Topic[Choice] <> '') and (Topic[Choice][1] <> '-'))
  685.                      or (Choice = OldChoice);
  686.                   WriteText(Choice,true);
  687.                end;
  688.                331: begin       {cursor left}
  689.                   WriteText(Choice,False);
  690.                   repeat
  691.                      dec(Choice);
  692.                      if Choice = 0 then
  693.                         Choice := TotalPicks;
  694.                   until ((Topic[Choice] <> '') and (Topic[Choice][1] <> '-'))
  695.                      or (Choice = OldChoice);
  696.                   WriteText(Choice,true);
  697.                end;
  698.                32,333: begin
  699.                   WriteText(Choice,false);
  700.                   repeat
  701.                      Choice := succ(Choice);
  702.                      if Choice > TotalPicks then
  703.                         Choice := 1;
  704.                   until ((Topic[Choice] <> '') and (Topic[Choice][1] <> '-'))
  705.                      or (Choice = OldChoice);
  706.                   WriteText(Choice,true);
  707.                end;
  708.                327: begin         {home key}
  709.                   WriteText(Choice,false);
  710.                   Choice := 1;
  711.                   while (Choice <> OldChoice)
  712.                   and (Choice <= TotalPicks)
  713.                   and ((Topic[Choice] <> '') and (Topic[Choice][1] <> '-')) do
  714.                      inc(Choice);
  715.                   WriteText(Choice,true);
  716.                end;
  717.                335: begin         {end key}
  718.                   WriteText(Choice,false);
  719.                   Choice := TotalPicks;
  720.                   while (Choice <> OldChoice)
  721.                   and (Choice > 1)
  722.                   and ((Topic[Choice] <> '') and (Topic[Choice][1] <> '-')) do
  723.                      dec(Choice);
  724.                   WriteText(Choice,true);
  725.                end;
  726.                13: begin          {enter key}
  727.                   Selected := true;
  728.                   Errorcode := 0;
  729.                end;
  730.                0: begin
  731.                   Selected := true;
  732.                   ErrorCode := Ecode;
  733.                end;
  734.                27: if AllowEsc then  {Esc}
  735.                begin
  736.                   Selected := true;
  737.                   ErrorCode := 1;
  738.                end else
  739.                begin
  740.                   WriteText(Choice,false);
  741.                   Choice := TotalPicks;
  742.                   WriteText(Choice,true);
  743.                end;
  744.                315..324: if Addprefix = 3 then   {F1 to F10}
  745.                begin
  746.                   if (TotalPicks >= Wkey - 314) and ((Topic[Wkey - 314] <> '') and (Topic[Wkey - 314][1] <> '-')) then
  747.                   begin
  748.                      WriteText(Choice,false);
  749.                      Choice := Wkey - 314;
  750.                      WriteText(Choice,true);
  751.                      Selected := true;
  752.                      Errorcode := 0;
  753.                   end;
  754.                end;
  755.                49..57: if (AddPrefix in [1,3]) then   {Number or Function Prefix} {4.02}
  756.                begin
  757.                   if (TotalPicks >= WKey - 48)
  758.                   and ((Topic[Wkey - 48] <> '') and (Topic[Wkey - 48][1] <> '-')) then
  759.                   begin
  760.                      WriteText(Choice,false);
  761.                      Choice := Wkey-48;
  762.                      WriteText(Choice,true);
  763.                      Selected := true;
  764.                      ErrorCode := 0;
  765.                   end;
  766.                end;
  767.                97..122,
  768.                65..90: if AddPrefix = 2 then
  769.                begin
  770.                   P := pos(upcase(char(WKey)),Alphabet);
  771.                   if (P in [1..TotalPicks])
  772.                   and ((Topic[P] <> '') and (Topic[P][1] <> '-')) then
  773.                   begin
  774.                      WriteText(Choice,false);
  775.                      Choice := P;
  776.                      WriteText(Choice,true);
  777.                      Selected := true;
  778.                      Errorcode := 0;
  779.                   end;
  780.                end else
  781.                begin
  782.                   if AddPrefix = 4 then
  783.                   begin
  784.                      Found := false;
  785.                      I := Choice;
  786.                      repeat
  787.                         if (FirstCapital(Topic[I]) = upcase(char(Wkey)))
  788.                         and (Topic[I] <> '')
  789.                         and (Topic[I][1] <> '-') then
  790.                         begin
  791.                            Found := true;
  792.                            WriteText(Choice,false);
  793.                            Choice := I;
  794.                            WriteText(Choice,true);
  795.                            Selected := true;
  796.                            Errorcode := 0;
  797.                         end else
  798.                         if I = TotalPicks then
  799.                            I := 1
  800.                         else
  801.                            Inc(I);
  802.                      until Found or (I = Choice);
  803.                   end;
  804.                end;
  805.                500: if KeyVars.MouseVisible then
  806.                   ProcessMouse;
  807.                540: if KeyVars.MouseVisible then
  808.                begin
  809.                   with KeyVars do
  810.                      I := TargetPick(LastX,LastY);
  811.                   if I <> 0 then
  812.                   begin
  813.                      if I <> Choice then
  814.                      begin
  815.                         WriteText(Choice,false);
  816.                         Choice := I;
  817.                         WriteText(Choice,true);
  818.                      end;
  819.                      Selected := true;
  820.                      Errorcode := 0;
  821.                   end;
  822.                   MouseRelease;
  823.                end;
  824.             end; {case}
  825.             Ecode := 0;
  826.             HindHook(Choice,Ecode);   {call the user hind hook}
  827.             if ECode <> 0 then
  828.             begin
  829.                ErrorCode := Ecode;
  830.                Selected := true;
  831.             end;
  832.          until Selected;
  833.          CursorSize(ScanTop,ScanBot);
  834.       end; {do}
  835.    end; { ProcessKeystrokes }
  836.  
  837. begin
  838.    GetDimensions;
  839.    if (Choice < 1) or (Choice > Menudef.TotalPicks) then
  840.       Choice := 1;
  841.    CreateMenu;
  842.    Ecode := 0;
  843.    MenuDef.HindHook(Choice,Ecode);   {call the user hind hook}
  844.    if ECode <> 0 then
  845.       ErrorCode := Ecode
  846.    else
  847.       ProcessKeystrokes;
  848.    if Window then
  849.       RmWin;
  850. end; {DisplayMenu}
  851.  
  852.                    {************************************}
  853.                    {**  P U L L D O W N    M E N U S  **}
  854.                    {************************************}
  855.  
  856. procedure InitBar(var P: Bar);
  857. {}
  858. begin
  859.    with P do
  860.    begin
  861.       ActiveChain := nil;
  862.       FirstItem := nil;
  863.       HKs := nil;
  864.       MainCount := 0;
  865.       TopX := 1;
  866.       TopY := 1;
  867.       DescX1 := MenuVars.MsgX1;
  868.       DescX2 := MenuVars.MsgX2;
  869.       DescY := MenuVars.MsgY;
  870.       Style := MenuVars.PullStyle;
  871.       ActiveItem := 1;
  872.       EraseFullLine := true;
  873.       HelpHook := NoPullHook;
  874.       HelpActive := false;
  875.       HelpKey := MenuVars.Helpkey;
  876.       HindHook := NoPullHook;
  877.    end;
  878. end; {InitBar}
  879.  
  880. procedure InitPopUp(var M:PopUp);
  881. {}
  882. begin
  883.    with M do
  884.    begin
  885.      FirstItem := nil;
  886.      ActiveItem := 1;
  887.      Width := 0;
  888.      ItemCount := 0;
  889.    end;
  890. end; { InitPopUp }
  891.  
  892. procedure AssignMenuHelpHook(var M: Bar; Proc:PullHook);
  893. {}
  894. begin
  895.    M.HelpHook := Proc;
  896.    M.HelpActive := @Proc <> @NoPullHook;
  897. end; { AssignMenuHelpHook }
  898.  
  899. procedure AssignMenuHindHook(var M: Bar; Proc:PullHook);
  900. {}
  901. begin
  902.    M.HindHook := Proc;
  903. end; { AssignMenuHindHook }
  904.  
  905. procedure RemoveMenuHelpHook(var M: Bar);
  906. {}
  907. begin
  908.    AssignMenuHelpHook(M,NoPullHook);
  909. end; { RemoveMenuHelpHook }
  910.  
  911. procedure RemoveMenuHindHook(var M: Bar);
  912. {}
  913. begin
  914.    AssignMenuHindHook(M,NoPullHook);
  915. end; { RemoveMenuHindHook }
  916.  
  917.                         {*************************}
  918.                         {**  Pointer Functions  **}
  919.                         {*************************}
  920.  
  921. function MainItemPtr(var M: Bar; Num:byte): PullItemPtr;
  922. {}
  923. var
  924.    MIP:PullItemPtr;
  925.    I: integer;
  926. begin
  927.    if Num > M.MainCount then
  928.       MainItemPtr := nil
  929.    else
  930.    begin
  931.       MIP := M.FirstItem;
  932.       for I := 2 to Num do
  933.          MIP := MIP^.NextPtr;
  934.       MainItemPtr := MIP;
  935.    end;
  936. end; { MainItemPtr }
  937.  
  938. function PopUpItemPtr(var P: PopUp; Num:byte): PullItemPtr;
  939. {}
  940. var
  941.    MIP:PullItemPtr;
  942.    I: integer;
  943. begin
  944.    if Num > P.ItemCount then
  945.       PopUpItemPtr := nil
  946.    else
  947.    begin
  948.       MIP := P.FirstItem;
  949.       for I := 2 to Num do
  950.          MIP := MIP^.NextPtr;
  951.       PopUpItemPtr := MIP;
  952.    end;
  953. end; { PopUpItemPtr }
  954.  
  955. function PreviousPopUpPtr(var M: Bar; Active: PopUpPtr):PopUpPtr;
  956. var
  957.    CP: ChainItemPtr;
  958. begin
  959.    CP := M.ActiveChain;
  960.    while (CP <> nil)
  961.    and (CP^.NextPtr <> nil)
  962.    and (CP^.NextPtr^.PopUp <> Active) do
  963.        CP := CP^.NextPtr;
  964.    if ((CP = nil) or (CP^.NextPtr = nil)) then
  965.       PreviousPopUpPtr := nil
  966.    else
  967.       PreviousPopUpPtr := CP^.PopUp;
  968. end; {PreviousPopUpPtr}
  969.  
  970. function ItemIDPtr(IP:PullItemPtr; ID:integer):PullItemPtr;
  971. {}
  972. begin
  973.    while (IP <> nil) and (IP^.ID <> ID) do
  974.       IP := IP^.NextPtr;
  975.    ItemIDPtr := IP;
  976. end; { ItemIDPtr }
  977.  
  978.                           {*********************}
  979.                           {**  Display procs  **}
  980.                           {*********************}
  981.  
  982. procedure DisplayHelpStr(var M:Bar; Hi:boolean);
  983. {}
  984. var A1,A2: byte;
  985. begin
  986.    if M.HelpActive then
  987.    begin
  988.       if Hi then
  989.       begin
  990.          A1 := Tint[PullHiHot];
  991.          A2 := Tint[PullHi];
  992.       end
  993.       else
  994.       begin
  995.          A1 := Tint[PullNormHot];
  996.          A2 := Tint[PullNorm];
  997.       end;
  998.       WriteHi(M.DescX1,M.DescY,A1,A2,MenuVars.HelpStr);
  999.    end;
  1000. end; { DisplayHelpStr }
  1001.  
  1002. procedure DisplayMainItem(var M:Bar; MP: PullItemPtr; Y:byte; Hi:boolean);
  1003. {}
  1004. var AHot,ANorm: byte;
  1005. begin
  1006.     if not MP^.Active then
  1007.     begin
  1008.        Ahot := Tint[PullOff];
  1009.        ANorm := Tint[PullOff];
  1010.     end
  1011.     else if Hi then
  1012.     begin
  1013.        Ahot := Tint[PullHiHot];
  1014.        ANorm := Tint[PullHi];
  1015.     end
  1016.     else
  1017.     begin
  1018.        Ahot := Tint[PullNormHot];
  1019.        ANorm := Tint[PullNorm];
  1020.     end;
  1021.     with MP^ do
  1022.        if Topic^ <> '' then
  1023.           WriteHi(XPackedWord(Status).X1,Y,AHot,ANorm,' '+Topic^+' ');
  1024.     if Hi then
  1025.     begin
  1026.        if M.TopY <> M.DescY then
  1027.        begin
  1028.           M.HelpMargin := 0;
  1029.           if not M.MsgDisplayed then {first message}
  1030.           begin
  1031.              ClearText(M.DescX1,M.DescY,M.DescX2,M.DescY, Tint[PullMsg]);
  1032.              DisplayHelpStr(M,false);
  1033.              if (MenuVars.HelpStr <> '') and M.HelpActive and (M.Style <> 4) then
  1034.              begin
  1035.                 M.HelpMargin := length(Strip('A',HiMarker,MenuVars.HelpStr))+2;
  1036.                 WritePlain(pred(M.DescX1 + pred(M.HelpMargin)),M.DescY,'│');
  1037.              end
  1038.              else
  1039.           end
  1040.           else
  1041.              ClearText(M.DescX1+M.HelpMargin,M.DescY,M.DescX2,M.DescY, Tint[PullMsg]);
  1042.           if MP^.LongDesc^ <> '' then
  1043.              WriteHiX2(M.DescX1+M.HelpMargin,M.DescX2,M.DescY,Tint[PullMsgHot],Tint[PullMsg],MP^.LongDesc^);
  1044.        end;
  1045.     end;
  1046. end; { DisplayMainItem }
  1047.  
  1048. function ExpandedItem(var Item: string; Width:byte):string;
  1049. {INTERNAL - expands the tab stops (if necessary) and returns the padded string}
  1050. var P,C: byte;
  1051. begin
  1052.    P := pos(MenuVars.TabChar,Item);
  1053.    C := CharCount(HiMarker,Item);
  1054.    if P = 0 then
  1055.       ExpandedItem := padleft(Item,width+C,' ')
  1056.    else
  1057.       ExpandedItem := copy(Item,1,pred(P))+replicate(succ(width)+C-length(Item),' ')+copy(Item,succ(P),255);
  1058. end; { ExpandedItem }
  1059.  
  1060. procedure DisplayPopUpItem(var M:Bar; var P:PopUp;ItemNum:byte;Selected:boolean; Style:byte);
  1061. {}
  1062. var
  1063.   Y,A1,A2:byte;
  1064.   IP: PullItemPtr;
  1065.   Txt: string[80];
  1066. begin
  1067.    with P do
  1068.    begin
  1069.       IP := PopUpItemPtr(P,ItemNum);
  1070.       if IP <> nil then
  1071.       begin
  1072.          Y := Y1 + ItemNum;
  1073.          if IP^.Topic^ = MenuVars.Separator then
  1074.          begin
  1075.             A1 := Tint[PullBorder1];
  1076.             case style of
  1077.                1: begin
  1078.                   WriteAt(succ(X1),Y,Tint[PullBorder1],'├');
  1079.                   WriteAt(pred(X2),Y,Tint[PullBorder1],'┤');
  1080.                   WriteAT(X1+2,Y,Tint[PullBorder1],replicate(X2-X1-3,'─'));
  1081.                end;
  1082.                2,3,4: begin
  1083.                   WriteAT(X1+2,Y,Tint[PullBorder2],replicate(X2-X1-3,'─'));
  1084.                end;
  1085.             end; {case}
  1086.          end
  1087.          else
  1088.          begin
  1089.             if Selected then
  1090.             begin
  1091.                if not IP^.Active then
  1092.                begin
  1093.                   A1 := Cattr(FAttr(Tint[PullOff]),BAttr(Tint[PullHi]));
  1094.                   A2 := A1;
  1095.                end
  1096.                else
  1097.                begin
  1098.                   A1 := Tint[PullHiHot];
  1099.                   A2 := Tint[PullHi];
  1100.                end;
  1101.             end
  1102.             else if not IP^.Active then
  1103.             begin
  1104.                A1 := Tint[PullOff];
  1105.                A2 := Tint[PullOff];
  1106.             end
  1107.             else
  1108.             begin
  1109.                A1 := Tint[PullNormHot];
  1110.                A2 := Tint[PullNorm];
  1111.             end;
  1112.             Txt := ExpandedItem(IP^.Topic^,X2-X1-5);
  1113.             if IP^.ChildPopUp <> nil then
  1114.                Txt[length(txt)] := '';
  1115.             with MenuVars do
  1116.             if Selected then
  1117.                WriteHi(X1+2,Y,A1,A2,PullLeft+Txt+PullRight)
  1118.             else
  1119.                WriteHi(X1+2,Y,A1,A2,' '+Txt+' ');
  1120.          end;
  1121.       end;
  1122.    end;
  1123.    if Selected then
  1124.    begin
  1125.       ClearText(M.DescX1+M.HelpMargin,M.DescY,M.DescX2,M.DescY, Tint[PullMsg]);
  1126.       if IP^.LongDesc^ <> '' then
  1127.          WriteHiX2(M.DescX1+M.HelpMargin,M.DescX2,M.DescY,Tint[PullMsgHot],Tint[PullMsg],IP^.LongDesc^);
  1128.    end;
  1129. end; { DisplayPopUpItem }
  1130.  
  1131. procedure DrawBar(var M: Bar);
  1132. {Draws the menu bar and verifies the X location of individual menu items}
  1133. var
  1134.    MP: PullItemPtr;
  1135.    StartX : byte;
  1136. begin
  1137.    if (M.Style > 4) or (M.Style < 1) then
  1138.        M.Style := MenuVars.PullStyle;
  1139.    with M do
  1140.    if (MainCount > 0) and (FirstItem <> nil) then
  1141.    begin
  1142.       MP := FirstItem;
  1143.       StartX := succ(TopX);
  1144.       case Style of
  1145.          1,2,3: begin
  1146.             MainY := TopY;
  1147.             if EraseFullLine then
  1148.                ClearLine(TopY,Tint[PullNorm]);
  1149.          end;
  1150.          4: begin
  1151.             StartX := TopX + 2;
  1152.             MainY := succ(TopY);
  1153.             if FastVars.CustomCharsActive then
  1154.                WriteAt(TopX,TopY,Tint[PullBorder2],chr(206)+chr(207))
  1155.             else
  1156.                WriteAt(TopX,TopY,Tint[PullBorder2],' ─ ');
  1157.          end;
  1158.       end; {case}
  1159.       while MP <> nil do
  1160.       begin
  1161.          with MP^ do
  1162.          with XPackedWord(Status) do
  1163.          begin
  1164.             X1 := StartX;
  1165.             X2 := X1 + succ(length(Strip('A',HiMarker,Topic^)));
  1166.             DisplayMainItem(M,MP,MainY,false);
  1167.             StartX := succ(X2);
  1168.          end;
  1169.          MP := MP^.NextPtr;
  1170.       end;
  1171.       MainX2 := pred(StartX);
  1172.    end;
  1173. end; {DrawBar}
  1174.  
  1175. function WidestTopic(P:PopUpPtr): byte;
  1176. {}
  1177. var
  1178.   TopicPtr: PullItemPtr;
  1179.   W,Widest: byte;
  1180. begin
  1181.    Widest := 0;
  1182.    TopicPtr := P^.FirstItem;
  1183.    while TopicPtr <> nil do
  1184.    begin
  1185.       W := length(Strip('A',HiMarker,TopicPtr^.Topic^))
  1186.            + ord(TopicPtr^.ChildPopUp <> nil);
  1187.       if pos(MenuVars.TabChar,TopicPtr^.Topic^) <> 0 then
  1188.          inc(W,2);
  1189.       if Widest < W then
  1190.          Widest := W;
  1191.       TopicPtr := TopicPtr^.NextPtr;
  1192.    end;
  1193.    WidestTopic := Widest;
  1194. end; { WidestTopic }
  1195.  
  1196. procedure DrawPopUp(var M: Bar; P:PopUpPtr; ActiveOn: boolean);
  1197. {INTERNAL}
  1198. var
  1199.    I: integer;
  1200.    CP: ChainItemPtr;
  1201. begin
  1202.    with M do
  1203.    begin
  1204.       MenuDown := true;
  1205.       {determine the X and Y coords}
  1206.       with P^ do
  1207.       begin
  1208.          if ActiveChain = nil then {no pop-ups visible}
  1209.          begin
  1210.             X1 := pred(XPackedWord(MainItemPtr(M,M.ActiveItem)^.Status).X1);
  1211.             Y1 := succ(M.MainY);
  1212.          end
  1213.          else
  1214.          begin
  1215.             CP := ActiveChain;
  1216.             while CP^.NextPtr <> nil do
  1217.                CP := CP^.NextPtr;
  1218.             X1 := CP^.PopUp^.X1 + 2;
  1219.             Y1 := CP^.PopUp^.Y1 + CP^.PopUp^.ActiveItem + 1;
  1220.          end;
  1221.          if (Width <> 0) and (Width > 8) then
  1222.             X2 := pred(X1 + Width)
  1223.          else  {find widest topic}
  1224.             X2 := X1 + WidestTopic(P) + 5;
  1225.          Y2 := Y1 + succ(ItemCount);
  1226.          case M.Style of
  1227.             1: MkPopUpWin(X1,Y1,X2,Y2,Tint[PullBorder1],Tint[PullBorder1],1);
  1228.             2: MkPopUpWin(X1,Y1,X2,Y2,Tint[PullBorder1],Tint[PullBorder2],1);
  1229.             3,4: MkPopUpWin(X1,Y1,X2,Y2,Tint[PullBorder1],Tint[PullBorder2],3);
  1230.          end;
  1231.          for I := 1 to ItemCount do
  1232.             DisplayPopUpItem(M,P^,I,ActiveOn and (I=ActiveItem),M.Style);
  1233.       end;
  1234.       {now update the chain}
  1235.       if ActiveChain = nil then
  1236.       begin
  1237.          getmem(ActiveChain,sizeof(ActiveChain^));
  1238.          CP := ActiveChain;
  1239.       end
  1240.       else
  1241.       begin
  1242.          CP := ActiveChain;
  1243.          while CP^.NextPtr <> nil do
  1244.             CP := CP^.NextPtr;
  1245.          getmem(CP^.NextPtr,sizeof(CP^));
  1246.          CP := CP^.NextPtr;
  1247.       end;
  1248.       CP^.NextPtr := nil;
  1249.       CP^.PopUp := P;
  1250.    end;
  1251. end; { DrawPopUp }
  1252.  
  1253.                     {*********************************}
  1254.                     {**  Main Menu Item Management  **}
  1255.                     {*********************************}
  1256.  
  1257. procedure PullItemDispose(IP: PullItemPtr;T,L:boolean);
  1258. {INTERNAL}
  1259. begin
  1260.    if IP <> nil then
  1261.    with IP^ do
  1262.    begin
  1263.       if T and (Topic <> nil) then
  1264.       begin
  1265.          freemem(Topic,ord(Topic^[0]));
  1266.          Topic := nil;
  1267.       end;
  1268.       if L and (LongDesc <> nil) then
  1269.       begin
  1270.          freemem(LongDesc,ord(LongDesc^[0]));
  1271.          LongDesc := nil;
  1272.       end;
  1273.    end;
  1274. end; { PullItemDispose }
  1275.  
  1276. procedure PullItemUpdate(IP: PullItemPtr;Item,Desc:string;HK,AHK:word;ID:integer; PopUp:pointer);
  1277. {INTERNAL}
  1278. var L: byte;
  1279. begin
  1280.    if IP <> nil then
  1281.    with IP^ do
  1282.    begin
  1283.       if Item[1] = MenuVars.InactiveChar then
  1284.       begin
  1285.          Active := false;
  1286.          delete(Item,1,1);
  1287.       end
  1288.       else
  1289.          Active := true;
  1290.       PullItemDispose(IP,Item <> NoChange,Desc <> NoChange);
  1291.       if Item <> NoChange then
  1292.       begin
  1293.          L := succ(length(Item));
  1294.          getmem(Topic,L);
  1295.          move(Item,Topic^,L);
  1296.       end;
  1297.       if (Desc <> NoChange) and (Desc <> '') then
  1298.       begin
  1299.          L := succ(length(Desc));
  1300.          getmem(LongDesc,L);
  1301.          move(Desc,LongDesc^,L);
  1302.       end;
  1303.       ChildPopUp := PopUp;
  1304.    end;
  1305.    IP^.ID := ID;
  1306.    IP^.HK := HK;
  1307.    IP^.AHK := AHK;
  1308. end; { PullItemUpdate }
  1309.  
  1310. function EngineAddItem(var FirstItem:PullItemPtr):PullItemPtr;
  1311. {INTERNAL}
  1312. var NewItem: PullItemPtr;
  1313. begin
  1314.    if FirstItem = nil then
  1315.    begin
  1316.       getmem(FirstItem,sizeof(FirstItem^));
  1317.       NewItem := FirstItem;
  1318.    end
  1319.    else
  1320.    begin
  1321.       NewItem := FirstItem;
  1322.       while NewItem^.NextPtr <> nil do
  1323.          NewItem := NewItem^.NextPtr;
  1324.       getmem(NewItem^.NextPtr,sizeof(NewItem^));
  1325.       NewItem := NewItem^.NextPtr;
  1326.    end;
  1327.    with NewItem^ do
  1328.    begin
  1329.       NextPtr := nil;
  1330.       Topic := nil;
  1331.       LongDesc := nil;
  1332.    end;
  1333.    EngineAddItem := NewItem;
  1334. end; { EngineAddItem }
  1335.  
  1336. procedure BarAddItem(var M: Bar; Item:string; ID:integer; HK,AltHK:word; Desc:string; PopUp:pointer);
  1337. {Called by user when adding a new item to the top menu}
  1338. var NewItem: PullItemPtr;
  1339. begin
  1340.    if (Item <> '') and (Item <> MenuVars.InActiveChar) then
  1341.    begin
  1342.       if GoldMemAvail < sizeof(M.FirstItem^) + 2 + length(Item) + length(Desc) then
  1343.          MenuSetError(1002)
  1344.       else with M do
  1345.       begin
  1346.          inc(MainCount);
  1347.          NewItem := EngineAddItem(FirstItem);
  1348.          PullItemUpdate(NewItem,Item,Desc,HK,AltHK,ID,PopUp);
  1349.       end;
  1350.    end;
  1351. end; { BarAddItem }
  1352.  
  1353. procedure BarSetActive(var M: Bar; ID:integer; On: boolean);
  1354. {}
  1355. var IP:PullItemPtr;
  1356. begin
  1357.    IP := ItemIDPtr(M.FirstItem,ID);
  1358.    if IP <> nil then
  1359.       IP^.Active := On
  1360.    else
  1361.       MenuSetError(1003);
  1362. end; { BarSetActive }
  1363.  
  1364. procedure BarChangeItem(var M: Bar; Item:string; ID,NewID:integer; HK,AltHK:word; Desc:string; PopUp:pointer);
  1365. {}
  1366. var IP:PullItemPtr;
  1367. begin
  1368.    IP := ItemIDPtr(M.FirstItem,ID);
  1369.    if IP <> nil then
  1370.       PullItemUpdate(IP,Item,Desc,HK,AltHK,NewID,PopUp)
  1371.    else
  1372.       MenuSetError(1003);
  1373. end; { BarChangeItem }
  1374.  
  1375. procedure BarChangeText(var M: Bar; ID:integer; Item,Desc:string);
  1376. {}
  1377. var IP:PullItemPtr;
  1378. begin
  1379.    IP := ItemIDPtr(M.FirstItem,ID);
  1380.    if IP <> nil then
  1381.       PullItemUpdate(IP,Item,Desc,IP^.HK,IP^.AHK,IP^.ID,IP^.ChildPopUp)
  1382.    else
  1383.       MenuSetError(1003);
  1384. end; { BarChangeText }
  1385.  
  1386. procedure EngineDelItem(FirstPtr:PullItemPtr; ID:integer);
  1387. {}
  1388. var IP,PrevPtr:PullItemPtr;
  1389. begin
  1390.    IP := ItemIDPtr(FirstPtr,ID);
  1391.    if IP <> nil then
  1392.    begin
  1393.       if IP = FirstPtr then
  1394.          FirstPtr := IP^.NextPtr
  1395.       else
  1396.       begin
  1397.          PrevPtr := FirstPtr;
  1398.          while PrevPtr^.NextPtr <> IP do
  1399.             PrevPtr := PrevPtr^.NextPtr;
  1400.          PrevPtr^.NextPtr := IP^.NextPtr;
  1401.       end;
  1402.       PullItemDispose(IP,true,true);
  1403.       freemem(IP,sizeof(IP^));
  1404.    end
  1405.    else
  1406.       MenuSetError(1003);
  1407. end; { EngineDelItem }
  1408.  
  1409. procedure BarDelItem(var M: Bar; ID:integer);
  1410. {}
  1411. begin
  1412.    EngineDelItem(M.FirstItem,ID);
  1413. end; { BarDelItem }
  1414.  
  1415.                     {**********************************}
  1416.                     {**  Popup Menu Item Management  **}
  1417.                     {**********************************}
  1418.  
  1419. procedure PopupAddItem(var P:PopUp;Item:string; ID:integer; HK:word; Desc:string; ChildMenu:pointer);
  1420. {}
  1421. var NewItem: PullItemPtr;
  1422. begin
  1423.    if (Item <> '') and (Item <> MenuVars.InActiveChar) then
  1424.    begin
  1425.       if GoldMemAvail < sizeof(P.FirstItem^) + 2 + length(Item) + length(Desc)then
  1426.          MenuSetError(1002)
  1427.       else with P do
  1428.       begin
  1429.          inc(ItemCount);
  1430.          NewItem := EngineAddItem(FirstItem);
  1431.          PullItemUpdate(NewItem,Item,Desc,HK,0,ID,ChildMenu);
  1432.       end;
  1433.    end;
  1434. end; { PopUpAddItem }
  1435.  
  1436. procedure PopUpSetActive(var P:PopUp; ID:integer; On: boolean);
  1437. {}
  1438. var IP:PullItemPtr;
  1439. begin
  1440.    IP := ItemIDPtr(P.FirstItem,ID);
  1441.    if IP <> nil then
  1442.       IP^.Active := On
  1443.    else
  1444.       MenuSetError(1003);
  1445. end; { PopUpSetActive }
  1446.  
  1447. procedure PopupChangeItem(var P:PopUp;Item:string; ID,NewID:integer; HK:word; Desc:string; ChildMenu:pointer);
  1448. {}
  1449. var IP:PullItemPtr;
  1450. begin
  1451.    IP := ItemIDPtr(P.FirstItem,ID);
  1452.    if IP <> nil then
  1453.       PullItemUpdate(IP,Item,Desc,HK,0,NewID,ChildMenu)
  1454.    else
  1455.       MenuSetError(1003);
  1456. end; { PopUpChangeItem }
  1457.  
  1458. procedure PopUpChangeText(var P:PopUp; ID:integer; Item,Desc:string);
  1459. {}
  1460. var IP:PullItemPtr;
  1461. begin
  1462.    IP := ItemIDPtr(P.FirstItem,ID);
  1463.    if IP <> nil then
  1464.       PullItemUpdate(IP,Item,Desc,IP^.HK,0,IP^.ID,IP^.ChildPopUp)
  1465.    else
  1466.       MenuSetError(1003);
  1467. end; { PopUpChangeText }
  1468.  
  1469. procedure PopUpDelItem(var P:PopUp; ID:integer);
  1470. {}
  1471. begin
  1472.    EngineDelItem(P.FirstItem,ID);
  1473. end; { PopUpDelItem }
  1474.  
  1475. procedure RemoveTopPopUp(var M: Bar);
  1476. {INTERNAL - only called when at least two pop-ups}
  1477. var CP: ChainItemPtr;
  1478. begin
  1479.    CP := M.ActiveChain;
  1480.    while CP^.NextPtr^.NextPtr <> nil do
  1481.       CP := CP^.NextPtr;
  1482.    freemem(CP^.NextPtr,sizeof(CP^));
  1483.    CP^.NextPtr := nil;
  1484.    RmWin;
  1485. end; { RemoveTopPopUp }
  1486.  
  1487. procedure RemoveAllPopUps(var M: Bar);
  1488. {INTERNAL}
  1489. var
  1490.   I,Counter: integer;
  1491.   Temp1,Temp2: ChainItemPtr;
  1492. begin
  1493.    with M do
  1494.    begin
  1495.       MenuDown := false;
  1496.       Temp1 := ActiveChain;
  1497.       Counter := 0;
  1498.       while Temp1 <> nil do
  1499.       begin
  1500.          Temp2 := Temp1^.NextPtr;
  1501.          inc(Counter);
  1502.          freemem(Temp1,sizeof(temp1^));
  1503.          Temp1 := Temp2;
  1504.       end;
  1505.       for I := 1 to Counter do
  1506.          RmWin;
  1507.       ActiveChain := nil;
  1508.    end;
  1509. end; { RemoveAllPopUps }
  1510.  
  1511.                         {**************************}
  1512.                         {**  HK Management  **}
  1513.                         {**************************}
  1514.  
  1515. procedure BarAddHK(var P: Bar; K:word; HotID:integer);
  1516. {}
  1517. var NewKey: HKPtr;
  1518. begin
  1519.    if GoldMemAvail < sizeof(p.HKs^) then
  1520.       MenuSetError(1002)
  1521.    else with P do
  1522.    begin
  1523.       if HKs = nil then
  1524.       begin
  1525.          getmem(HKs,sizeof(HKs^));
  1526.          NewKey := HKs;
  1527.       end
  1528.       else
  1529.       begin
  1530.          NewKey := HKs;
  1531.          while NewKey^.NextPtr <> nil do
  1532.             NewKey := NewKey^.NextPtr;
  1533.          getmem(NewKey^.NextPtr,sizeof(NewKey^));
  1534.          NewKey := NewKey^.NextPtr;
  1535.       end;
  1536.       with NewKey^ do
  1537.       begin
  1538.          HK := K;
  1539.          ID := HotID;
  1540.          NextPtr := nil;
  1541.       end;
  1542.    end;
  1543. end; { BarAddHK }
  1544.  
  1545. procedure BarDelHK(var P: Bar; K:word);
  1546. {}
  1547. var
  1548.    Temp, NewKey: HKPtr;
  1549. begin
  1550.    if P.HKs^.HK = K then {first Item matches}
  1551.    begin
  1552.       Temp := P.HKs;
  1553.       P.HKs := P.HKs^.NextPtr;
  1554.       freemem(Temp,sizeof(Temp^));
  1555.    end
  1556.    else
  1557.    begin
  1558.       NewKey := P.HKs;
  1559.       while (NewKey^.NextPtr <> nil) and (Newkey^.NextPtr^.HK <> K) do
  1560.          NewKey := NewKey^.NextPtr;
  1561.       if NewKey^.NextPtr <> nil then {found it}
  1562.       begin
  1563.          Temp := NewKey^.NextPtr;
  1564.          NewKey^.NextPtr := Temp^.NextPtr;
  1565.          freemem(Temp,sizeof(Temp^));
  1566.       end;
  1567.    end;
  1568. end; { BarDelHK }
  1569.  
  1570. procedure DestroyAllHKs(var M: Bar);
  1571. {INTERNAL}
  1572. var
  1573.    Temp1, Temp2: HKPtr;
  1574.    S:word;
  1575. begin
  1576.    Temp1 := M.HKs;
  1577.    S := sizeof(Temp1^);
  1578.    while Temp1 <> nil do
  1579.    begin
  1580.       Temp2 := Temp1^.NextPtr;
  1581.       freemem(Temp1,S);
  1582.       Temp1 := Temp2;
  1583.    end;
  1584.    M.HKs := nil;
  1585. end; { DestroyAllHKs }
  1586.  
  1587.                        {****************************}
  1588.                        {**  Menu Memory Disposal  **}
  1589.                        {****************************}
  1590.  
  1591. procedure DestroyItemChain(FirstItem:PullItemPtr);
  1592. {}
  1593. var
  1594.   Ptr1,Ptr2: PullItemPtr;
  1595. begin
  1596.    Ptr1 := FirstItem;
  1597.    while Ptr1 <> nil do
  1598.    begin
  1599.       Ptr2 := Ptr1^.NextPtr;
  1600.       with Ptr1^ do
  1601.       begin
  1602.          if Topic <> nil then
  1603.             freemem(Topic, succ(ord(Topic^[0])));
  1604.          if LongDesc <> nil then
  1605.             freemem(LongDesc, succ(ord(LongDesc^[0])));
  1606.       end;
  1607.       freemem(Ptr1,sizeof(Ptr1^));
  1608.       Ptr1 := Ptr2;
  1609.    end;
  1610. end; { DestroyItemChain }
  1611.  
  1612. procedure DestroyPopUp(P:PopUp);
  1613. {}
  1614. begin
  1615.    DestroyItemChain(P.FirstItem);
  1616.    P.FirstItem := nil;
  1617. end; { DestroyPopUp }
  1618.  
  1619. procedure DestroyBar(M:Bar);
  1620. {}
  1621. begin
  1622.    DestroyAllHKs(M);
  1623.    DestroyItemChain(M.FirstItem);
  1624.    M.FirstItem := nil;
  1625. end; { DestroyBar }
  1626.  
  1627.                      {********************************}
  1628.                      {**  Pull Keyboard Management  **}
  1629.                      {********************************}
  1630.  
  1631. function AltHotkeyTopicItem(var P: Bar; K:word): integer;
  1632. {Returns the number (not ID) of the topic whose hot key was pressed, or
  1633. 0 if not a valid Bar hotkey}
  1634. var
  1635.   MP: PullItemPtr;
  1636.   Counter: integer;
  1637. begin
  1638.    MP := P.FirstItem;
  1639.    Counter := 1;
  1640.    while (MP <> nil) and not ((MP^.AHK = K) and (MP^.Active)) do
  1641.    begin
  1642.       MP := MP^.NextPtr;
  1643.       inc(Counter);
  1644.    end;
  1645.    if MP = nil then
  1646.       AltHotkeyTopicItem := 0
  1647.    else
  1648.       AltHotkeyTopicItem := Counter;
  1649. end; { HotkeyTopicItem }
  1650.  
  1651. function HotkeyTopicItem(IP:PullItemPtr; Hotkey:word): byte;
  1652. {Returns the byte of the topic whose hotkey was pressed or 0 for not found}
  1653. var Counter: integer;
  1654. begin
  1655.    HotKey := CapitalWord(Hotkey);
  1656.    Counter := 1;
  1657.    while (iP <> nil) and not ((IP^.HK = Hotkey) and (IP^.Active)) do
  1658.    begin
  1659.       IP := IP^.NextPtr;
  1660.       inc(Counter);
  1661.    end;
  1662.    if IP = nil then
  1663.       HotkeyTopicItem := 0
  1664.    else
  1665.       HotkeyTopicItem := Counter;
  1666. end; { HotkeyTopicItem }
  1667.  
  1668. function HKTopicID(var P: Bar; K:word): integer;
  1669. {}
  1670. var KP: HKPtr;
  1671. begin
  1672.    HKTopicID := 0;
  1673.    KP := P.HKs;
  1674.    while (KP <> nil) and (KP^.HK <> K) do
  1675.       KP := KP^.NextPtr;
  1676.    if KP <> nil then
  1677.       HKTopicID := KP^.ID;
  1678. end; { HKTopicID }
  1679.  
  1680. function IsPullKey(var P: Bar; K:word; X,Y:byte):boolean;
  1681. {}
  1682. begin
  1683.    with P do
  1684.    if (K = MenuVars.ActivateKey)
  1685.    or (
  1686.        (K = 500) and (Y = P.MainY) and (X >= TopX) and (X <= MainX2)
  1687.       ) then
  1688.       IsPullkey := true
  1689.    else if HKTopicID(P,K) <> 0 then
  1690.       IsPullKey := true
  1691.    else
  1692.       IsPullKey := AltHotkeyTopicItem(P,K) <> 0;
  1693. end; {IsPullKey}
  1694.  
  1695. function BarProcessKey(var M: Bar; K:word; X,Y:byte; var ID:integer): boolean;
  1696. {Returns true if user made a selection or escaped}
  1697. var
  1698.    TempItem: byte;
  1699.    CP: PopUpPtr;
  1700.    IP: PullItemPtr;
  1701.  
  1702.    procedure SelectTopic;
  1703.    {}
  1704.    begin
  1705.       CP := MainItemPtr(M,M.ActiveItem)^.ChildPopUp;
  1706.       if CP <> nil then
  1707.          DrawPopUp(M,CP,true)
  1708.       else
  1709.       begin
  1710.          BarProcessKey := true;
  1711.          ID := MainItemPtr(M,M.ActiveItem)^.ID;
  1712.       end;
  1713.    end; { SelectTopic }
  1714.  
  1715. begin
  1716.    BarProcessKey := false;
  1717.    with M do
  1718.    case K of
  1719.       500: ;  {mouse down}
  1720.       13: begin {mouse enter}
  1721.          if MainItemPtr(M,M.ActiveItem)^.Active then
  1722.             SelectTopic;
  1723.       end;
  1724.       336: begin
  1725.          CP := MainItemPtr(M,M.ActiveItem)^.ChildPopUp;
  1726.          if CP <> nil then
  1727.             DrawPopUp(M,CP,true);
  1728.       end;
  1729.       331: if MainCount > 1 then {left}
  1730.       begin
  1731.          DisplayMainItem(M,MainItemPtr(M,ActiveItem),MainY,false);
  1732.          TempItem := ActiveItem;
  1733.          repeat
  1734.             if ActiveItem = 1 then
  1735.                ActiveItem := MainCount
  1736.             else
  1737.                dec(ActiveItem);
  1738.          until MainItemPtr(M,ActiveItem)^.Active or (TempItem = ActiveItem);
  1739.          IP := MainItemPtr(M,ActiveItem);
  1740.          DisplayMainItem(M,IP,MainY,true);
  1741.          ID := ActiveItem;
  1742.          if MenuDown and (IP^.ChildPopUp <> nil) then
  1743.             DrawPopUp(M,IP^.ChildPopUp,true);
  1744.       end;
  1745.       333: begin {right}
  1746.          DisplayMainItem(M,MainItemPtr(M,ActiveItem),MainY,false);
  1747.          TempItem := ActiveItem;
  1748.          repeat
  1749.             if ActiveItem = MainCount then
  1750.                ActiveItem := 1
  1751.             else
  1752.                inc(ActiveItem);
  1753.          until MainItemPtr(M,ActiveItem)^.Active or (TempItem = ActiveItem);
  1754.          IP := MainItemPtr(M,ActiveItem);
  1755.          DisplayMainItem(M,IP,MainY,true);
  1756.          ID := ActiveItem;
  1757.          if MenuDown and (IP^.ChildPopUp <> nil) then
  1758.             DrawPopUp(M,IP^.ChildPopUp,true);
  1759.       end;
  1760.       27: begin
  1761.           BarProcessKey := true;
  1762.           ID := 0;
  1763.       end;
  1764.       32..255: begin  {user pressed a letter}
  1765.          TempItem := HotkeyTopicItem(M.FirstItem,K);
  1766.          if TempItem <> 0 then
  1767.          begin
  1768.             DisplayMainItem(M,MainItemPtr(M,ActiveItem),MainY,false);
  1769.             ActiveItem := TempItem;
  1770.             DisplayMainItem(M,MainItemPtr(M,ActiveItem),MainY,true);
  1771.             ID := ActiveItem;
  1772.             SelectTopic;
  1773.          end;
  1774.       end;
  1775.  
  1776.    end;
  1777. end; { BarProcessKey }
  1778.  
  1779. function PopUpProcessKey(var M: Bar;CP: ChainItemPtr; K:word; X,Y:byte; var ID:integer): boolean;
  1780. {Returns true if user made a selection or escaped}
  1781. var
  1782.    TempItem: byte;
  1783.    IP: PullItemPtr;
  1784.  
  1785.    procedure SelectTopic;
  1786.    {}
  1787.    begin
  1788.       with CP^.PopUp^ do
  1789.       begin
  1790.          IP := PopUpItemPtr(CP^.PopUp^,ActiveItem);
  1791.          if IP^.ChildPopUp <> nil then
  1792.             DrawPopUp(M,IP^.ChildPopUp,true)
  1793.          else
  1794.          begin
  1795.             PopUpProcessKey := true;
  1796.             ID := IP^.ID;
  1797.          end;
  1798.       end;
  1799.    end; { SelectTopic }
  1800.  
  1801. begin
  1802.    PopUpProcessKey := false;
  1803.    with CP^.PopUp^ do
  1804.    case K of
  1805.       13: begin {enter}
  1806.           if PopUpItemPtr(CP^.PopUp^,ActiveItem)^.Active then
  1807.              SelectTopic;
  1808.       end;
  1809.       331: begin
  1810.          PopUpProcessKey := true;
  1811.          ID := GPullLeft;
  1812.       end;
  1813.       333: begin
  1814.          PopUpProcessKey := true;
  1815.          ID := GPullRight;
  1816.       end;
  1817.       328: begin  {up}
  1818.          DisplayPopUpItem(M,CP^.PopUp^,ActiveItem,false,M.Style);
  1819.          TempItem := ActiveItem;
  1820.          repeat
  1821.             if ActiveItem = 1 then
  1822.                ActiveItem := ItemCount
  1823.             else
  1824.                dec(ActiveItem);
  1825.             IP := PopUpItemPtr(CP^.PopUp^,ActiveItem);
  1826.          until ( (IP^.Topic^ <> MenuVars.Separator) and IP^.Active)
  1827.                or
  1828.                (TempItem = ActiveItem);
  1829.          DisplayPopUpItem(M,CP^.PopUp^,ActiveItem,true,M.Style);
  1830.          ID :=ActiveItem;
  1831.       end;
  1832.       336: begin  {down}
  1833.          DisplayPopUpItem(M,CP^.PopUp^,ActiveItem,false,M.Style);
  1834.          TempItem := ActiveItem;
  1835.          repeat
  1836.             if ActiveItem = ItemCount then
  1837.                ActiveItem := 1
  1838.             else
  1839.                inc(ActiveItem);
  1840.             IP := PopUpItemPtr(CP^.PopUp^,ActiveItem);
  1841.          until ( (IP^.Topic^ <> MenuVars.Separator) and IP^.Active)
  1842.                or
  1843.                (TempItem = ActiveItem);
  1844.          DisplayPopUpItem(M,CP^.PopUp^,ActiveItem,true,M.Style);
  1845.          ID :=ActiveItem;
  1846.       end;
  1847.       27: begin
  1848.          PopUpProcessKey := true;
  1849.          ID := 0;
  1850.       end;
  1851.       32..255: begin  {user pressed a letter}
  1852.          TempItem := HotkeyTopicItem(CP^.PopUp^.FirstItem,K);
  1853.          if TempItem <> 0 then
  1854.          begin
  1855.             DisplayPopUpItem(M,CP^.PopUp^,ActiveItem,false,M.Style);
  1856.             ActiveItem := TempItem;
  1857.             DisplayPopUpItem(M,CP^.PopUp^,ActiveItem,true,M.Style);
  1858.             SelectTopic;
  1859.          end;
  1860.       end;
  1861.    end; {case}
  1862. end; { PopUpProcessKey }
  1863.  
  1864. function ActiveMenuID(var M: Bar): integer;
  1865. {}
  1866. var
  1867.   CP: ChainItemPtr;
  1868. begin
  1869.    with M do
  1870.    begin
  1871.       if M.ActiveChain = nil then
  1872.          ActiveMenuID := MainItemPtr(M,M.ActiveItem)^.ID
  1873.       else
  1874.       begin
  1875.          CP := M.ActiveChain;
  1876.          while CP^.NextPtr <> nil do
  1877.             CP := CP^.NextPtr;
  1878.          ActiveMenuID := PopUpItemPtr(CP^.PopUp^,CP^.PopUp^.ActiveItem)^.ID;
  1879.       end;
  1880.    end;
  1881. end; { ActiveMenuID }
  1882.  
  1883. function PullProcessMouse(var M: Bar; var ID:integer): boolean;
  1884. {Called when the user presses the mouse down}
  1885. var
  1886.    L,Middle,R: boolean;
  1887.    X,Y:byte;
  1888.    P: PullItemPtr;
  1889.    PopUpCount,
  1890.    Counter: integer;
  1891.    ActivePopUp: PopUpPtr;
  1892.    PopUpItemHi: boolean;
  1893.    CP: ChainItemPtr;
  1894.  
  1895.    procedure MouseOnMainBar;
  1896.    {}
  1897.    begin
  1898.       with M do
  1899.       begin
  1900.          P := FirstItem;
  1901.          Counter := 1;
  1902.          while (P <> nil)
  1903.          and ( (X < XPackedWord(P^.Status).X1) or (X > XPackedWord(P^.Status).X2)) do
  1904.          begin
  1905.             P := P^.NextPtr;
  1906.             inc(Counter);
  1907.          end;
  1908.          if (P <> nil)
  1909.          and (
  1910.               (Counter <> ActiveItem)
  1911.               or
  1912.               ((P^.ChildPopUp <> nil) and (ActiveChain = nil))
  1913.              )
  1914.          and (P^.Active) then
  1915.          begin
  1916.             if ActiveChain <> nil then
  1917.                RemoveAllPopUps(M);
  1918.             DisplayMainItem(M,MainItemPtr(M,ActiveItem),MainY,false);
  1919.             ActiveItem := Counter;
  1920.             DisplayMainItem(M,P,MainY,true);
  1921.             if (P^.ChildPopUp <> nil) then
  1922.             begin
  1923.                DrawPopUp(M,P^.ChildPopUp,false);
  1924.                MenuDown := true;
  1925.             end;
  1926.             PopUpItemHi := false;
  1927.          end;
  1928.       end;
  1929.    end; { MouseOnMainBar }
  1930.  
  1931.    function WhichPopUp:PopUpPtr;
  1932.    {}
  1933.    var
  1934.       P: PopUpPtr;
  1935.    begin
  1936.       WhichPopUp := nil;
  1937.       CP := M.ActiveChain;
  1938.       Counter := 1;
  1939.       while (CP <> nil) and (CP^.NextPtr <> nil) do
  1940.       begin
  1941.          CP := CP^.NextPtr;
  1942.          inc(Counter);
  1943.       end;
  1944.       PopUpCount := Counter;
  1945.       if CP <> nil then
  1946.       begin
  1947.          P := CP^.PopUp;
  1948.          while P <> nil do
  1949.          begin
  1950.             with P^ do
  1951.               if (X >= X1) and (Y >= Y1) and (X <= X2) and (Y <= y2) then
  1952.               begin
  1953.                  WhichPopUp := P;
  1954.                  exit;
  1955.               end
  1956.               else
  1957.               begin
  1958.                  P := PreviousPopUpPtr(M,P);
  1959.                  dec(Counter);
  1960.               end;
  1961.          end; {while}
  1962.       end;
  1963.    end; { WhichPopUp }
  1964.  
  1965.    procedure MouseOnPopUp;
  1966.    {}
  1967.    var
  1968.       P: PopUpPtr;
  1969.       ItemNum: byte;
  1970.       I: integer;
  1971.    begin
  1972.       P := WhichPopUp;
  1973.       if P <> nil then {mouse is over a PopUp}
  1974.          with P^ do
  1975.          begin
  1976.             for I := succ(Counter) to PopUpCount do
  1977.                RemoveTopPopUp(M);
  1978.             if (X > succ(X1)) and (X < pred(X2)) and (Y > Y1) and (Y < Y2)
  1979.             and (PopUpItemPtr(P^,Y-Y1)^.Topic^ <> MenuVars.Separator) then
  1980.             begin
  1981.                if (PopUpItemHi = false) or (ActiveItem <> Y-Y1) then
  1982.                begin
  1983.                   if ActiveItem <> Y-Y1 then
  1984.                   begin
  1985.                      DisplayPopUpItem(M,P^,ActiveItem,false,M.Style);
  1986.                      ActiveItem := Y - Y1;
  1987.                   end;
  1988.                   DisplayPopUpItem(M,P^,ActiveItem,true,M.Style);
  1989.                   PopUpItemHi := true;
  1990.                end;
  1991.             end
  1992.             else   {on border}
  1993.             begin
  1994.                if PopUpItemHi then
  1995.                begin
  1996.                   DisplayPopUpItem(M,P^,ActiveItem,false,M.Style);
  1997.                   PopUpItemHi := false;
  1998.                end;
  1999.             end;
  2000.          end;
  2001.    end; { MouseOnPopUp }
  2002.  
  2003.    function MouseOverHelpText(X,Y:byte): boolean;
  2004.    {}
  2005.    begin
  2006.       with M do
  2007.          MouseOverHelpText :=  (Y = DescY)
  2008.                                and (X >= DescX1)
  2009.                                and (X <= pred(DescX1) + length(Strip('A',HiMarker,MenuVars.HelpStr)));
  2010.    end; { MouseOverHelpText }
  2011.  
  2012.    procedure MouseHelpAction;
  2013.    {}
  2014.    var
  2015.      A1,A2: byte;
  2016.      Hi: boolean;
  2017.    begin
  2018.       Hi := false;
  2019.       repeat
  2020.          MouseStatus(L,Middle,R,X,Y);
  2021.          if MouseOverHelpText(X,Y) and not Hi then
  2022.          begin
  2023.             DisplayHelpStr(M,true);
  2024.             Hi := true;
  2025.          end else if Hi and not MouseOverHelpText(X,Y) then
  2026.          begin
  2027.             DisplayHelpStr(M,false);
  2028.             Hi := false;
  2029.          end;
  2030.       until not L;
  2031.       if MouseOverHelpText(X,Y) then
  2032.       begin
  2033.          SaveScreen(InternalScreen3);
  2034.          M.HelpHook(ActiveMenuID(M));
  2035.          RestoreScreen(InternalScreen3);
  2036.          DisposeScreen(InternalScreen3);
  2037.       end;
  2038.       DisplayHelpStr(M,false);
  2039.       MouseRelease;
  2040.       PullProcessMouse := false;
  2041.    end; { MouseHelpAction }
  2042.  
  2043. begin
  2044.    PopUpItemHi := true;
  2045.    with M do
  2046.    begin
  2047.       MouseStatus(L,Middle,R,X,Y);
  2048.       if HelpActive and L and (M.Style <> 4) and MouseOverHelpText(X,Y) then
  2049.          MouseHelpAction
  2050.       else
  2051.       begin
  2052.          repeat
  2053.             MouseStatus(L,Middle,R,X,Y);
  2054.             if (Y = M.MainY) and (X >= TopX) and (X <= MainX2) then {on main bar}
  2055.                MouseOnMainBar
  2056.             else
  2057.             begin
  2058.                ActivePopUp := WhichPopUp;
  2059.                if ActivePopUp <> nil then
  2060.                   MouseOnPopUp
  2061.                else if PopUpItemHi then {need to turn off active pick}
  2062.                begin
  2063.                   PopUpItemHi := false;
  2064.                   CP := ActiveChain;
  2065.                   while (CP <> nil) and (CP^.NextPtr <> nil) do
  2066.                      CP := CP^.NextPtr;
  2067.                   DisplayPopUpItem(M,CP^.PopUp^,CP^.PopUp^.ActiveItem,false,M.Style);
  2068.                end;
  2069.             end;
  2070.          until not L;
  2071.          MouseRelease;
  2072.          if (Y = MainY) and (X >= TopX) and (X <= MainX2) then {on main bar}
  2073.          begin
  2074.             if ActiveChain <> nil then    {Activate the Pop-Up}
  2075.             begin
  2076.                PullProcessMouse := false;
  2077.                DisplayPopUpItem(M,ActiveChain^.PopUp^,ActiveChain^.PopUp^.ActiveItem,true,M.Style);
  2078.             end
  2079.             else
  2080.             begin
  2081.                PullProcessMouse := true;
  2082.                if MainItemPtr(M,M.ActiveItem)^.Active then
  2083.                   ID := MainItemPtr(M,M.ActiveItem)^.ID
  2084.                else
  2085.                   ID := 0;
  2086.             end;
  2087.          end
  2088.          else {see if mouse on top popup}
  2089.          begin
  2090.             CP := ActiveChain;
  2091.             while (CP <> nil) and (CP^.NextPtr <> nil) do
  2092.                CP := CP^.NextPtr;
  2093.             if (CP <> nil) and PopUpItemHi then {mouse is over a popup topic}
  2094.             begin
  2095.                P := PopUpItemPtr(CP^.PopUp^,CP^.PopUp^.ActiveItem);
  2096.                if P^.Active then
  2097.                begin
  2098.                   ID := P^.ID;
  2099.                   if P^.ChildPopUp <> nil then
  2100.                   begin
  2101.                      PullProcessMouse := false;
  2102.                      DrawPopUp(M,P^.ChildPopUp,true)
  2103.                   end
  2104.                   else
  2105.                      PullProcessMouse := true;
  2106.                end
  2107.                else
  2108.                  PullProcessMouse := false;
  2109.             end
  2110.             else    {mouse released away from menu areas}
  2111.             begin
  2112.                PullProcessMouse := true;
  2113.                ID := 0
  2114.             end;
  2115.          end;
  2116.       end;
  2117.    end;
  2118. end; { PullProcessMouse }
  2119.  
  2120. function PullProcessKey(var M: Bar; K:word; X,Y:byte; var ID:integer):boolean;
  2121. {Returns true if user made a selection or escaped}
  2122. var
  2123.   CP: ChainItemPtr;
  2124.   MIP:PullItemPtr;
  2125.   Item: byte;
  2126.  
  2127.   procedure SendtoPopup;
  2128.   {}
  2129.   begin
  2130.      with M do
  2131.      begin
  2132.         if PopUpProcessKey(M,CP,K,X,Y,ID) then
  2133.         begin
  2134.            case ID of
  2135.               0: begin {user escaped need to remove a popup}
  2136.                  if M.ActiveChain^.NextPtr = nil then
  2137.                     Pullprocesskey := true
  2138.                  else
  2139.                     RemoveTopPopUp(M);
  2140.               end;
  2141.               GPullLeft: begin
  2142.                  RemoveAllPopUps(M);
  2143.                  M.MenuDown := true;
  2144.                  PullProcessKey := BarProcessKey(M,331,X,Y,ID);
  2145.               end;
  2146.               GPullRight: begin
  2147.                  RemoveAllPopUps(M);
  2148.                  M.MenuDown := true;
  2149.                  PullProcessKey := BarProcessKey(M,333,X,Y,ID);
  2150.               end;
  2151.               else  {user made a selection}
  2152.                  PullProcessKey := true;
  2153.            end; {case}
  2154.         end;
  2155.      end;
  2156.   end; { SendtoPopup }
  2157.  
  2158. begin
  2159.    {see if a kwik key was pressed}
  2160.    ID := HKTopicID(M,K);
  2161.    if ID <> 0 then
  2162.       PullprocessKey := true
  2163.    else
  2164.    begin
  2165.       PullProcessKey := false;
  2166.       Item := AltHotkeyTopicItem(M,K);
  2167.       if Item <> 0 then  {user press main menu level hot key, e.g. Alt-F}
  2168.       begin
  2169.          if M.ActiveChain <> nil then
  2170.             RemoveAllPopUps(M);
  2171.          DisplayMainItem(M,MainItemPtr(M,M.ActiveItem),M.MainY,false);
  2172.          M.ActiveItem := Item;
  2173.          MIP := MainItemPtr(M,Item);
  2174.          if MIP^.ChildPopUp = nil then {no popup}
  2175.          begin
  2176.             ID := MIP^.ID;
  2177.             PullprocessKey := true
  2178.          end
  2179.          else
  2180.          begin
  2181.             DisplayMainItem(M,MIP,M.MainY,true);
  2182.             DrawPopUp(M,MIP^.ChildPopUp,true);
  2183.          end;
  2184.       end
  2185.       else if K = MenuVars.ActivateKey then   {user pressed menu activate e.g. F10}
  2186.       begin
  2187.          with M do
  2188.          begin
  2189.             if ActiveChain <> nil then
  2190.                RemoveAllPopUps(M);
  2191.             DisplayMainItem(M,MainItemPtr(M,ActiveItem),M.MainY,true);
  2192.          end;
  2193.       end else if K = 500 then
  2194.          PullProcessKey := PullProcessMouse(M,ID)
  2195.       else if K = MenuVars.HelpKey then
  2196.       begin
  2197.          SaveScreen(InternalScreen3);
  2198.          M.HelpHook(ActiveMenuID(M));
  2199.          RestoreScreen(InternalScreen3);
  2200.          DisposeScreen(InternalScreen3);
  2201.       end
  2202.       else if M.ActiveChain = nil then {no popups visible}
  2203.          PullProcessKey := BarProcessKey(M,K,X,Y,ID)
  2204.       else    {find the active popup}
  2205.       begin
  2206.          CP := M.ActiveChain;
  2207.          while CP^.NextPtr <> nil do
  2208.             CP := CP^.NextPtr;
  2209.          SendToPopUp;
  2210.       end;
  2211.    end;
  2212.    M.HindHook(ActiveMenuID(M));
  2213. end; { PullProcessKey }
  2214.  
  2215. function PullPushKey(var M: Bar; K:word; X,Y:byte): integer;
  2216. {Displays the menu and returns the ID of the selected field,
  2217. or 0 if user escaped}
  2218. var
  2219.   ID: integer;
  2220.   FirstIteration: boolean;
  2221.   CursorX,CursorY,ScanTop,ScanBot: byte;
  2222.   MsgArea: pointer;
  2223.   MsgSize: integer;
  2224. begin
  2225.    if WinList <> nil then
  2226.       ActivateVisibleScreen;
  2227.    FirstIteration := true;
  2228.    CursorFind(CursorX,CursorY,ScanTop,ScanBot);
  2229.    CursorOff;
  2230.    MsgSize := succ(M.DescX2 - M.DescX1) * 2;
  2231.    if (M.Style > 4) or (M.Style < 1) then
  2232.        M.Style := MenuVars.PullStyle;
  2233.    if GoldMemAvail >= MsgSize then
  2234.    begin
  2235.       getmem(MsgArea,MsgSize);
  2236.       PartSave(M.DescX1,M.DescY,M.DescX2,M.DescY,MsgArea^);
  2237.    end
  2238.    else
  2239.       MsgArea := nil;
  2240.    M.MsgDisplayed := false;
  2241.    with M do
  2242.       DisplayMainItem(M,MainItemPtr(M,ActiveItem),MainY,true);
  2243.    repeat
  2244.       if (FirstIteration = false) or ((K=0) and (X=0) and (Y=0)) then
  2245.       begin
  2246.          GetInput;
  2247.          K := KeyVars.LastKey;
  2248.          X := KeyVars.LastX;
  2249.          Y := KeyVars.LastY;
  2250.       end;
  2251.       FirstIteration := false;
  2252.    until PullProcessKey (M,K,X,Y,ID);
  2253.    with M do
  2254.       DisplayMainItem(M,MainItemPtr(M,ActiveItem),MainY,false);
  2255.    RemoveAllPopUps(M);
  2256.    PullPushKey := ID;
  2257.    if MsgArea <> nil then
  2258.    begin
  2259.       PartRestore(M.DescX1,M.DescY,M.DescX2,M.DescY,MsgArea^);
  2260.       freemem(MsgArea,MsgSize);
  2261.    end;
  2262.    CursorPos(CursorX,CursorY);
  2263.    CursorSize(ScanTop,ScanBot);
  2264.    if WinList <> nil then
  2265.       ActivateTopWindow;
  2266. end; { PullPushKey }
  2267.  
  2268. function ActivatePullMenu(var P: Bar): integer;
  2269. {}
  2270. begin
  2271.    ActivatePullMenu := PullPushKey(P,0,0,0);
  2272. end; { ActivatePullMenu }
  2273.  
  2274.               {*********************************************}
  2275.               {**  U N I T   I N I T I A L I Z A T I O N  **}
  2276.               {*********************************************}
  2277. procedure MenuDefaultSettings;
  2278. {}
  2279. begin
  2280.    with MenuVars do
  2281.    begin
  2282.       if ColorScreen then
  2283.       begin
  2284.          MenuLeft := ' ';
  2285.          MenuRight := ' ';
  2286.          PullLeft := ' ';
  2287.          PullRight := ' ';
  2288.       end
  2289.       else
  2290.       begin
  2291.          MenuLeft := '';
  2292.          MenuRight := '';
  2293.          PullLeft := '';
  2294.          PullRight := '';
  2295.       end;
  2296.       PullSubIndicator := '';
  2297.       InActiveChar := '!';
  2298.       TabChar := ':';
  2299.       ToggleChar := '|';
  2300.       ActivateKey := 324; {F10}
  2301.       Separator := '-';
  2302.       PullStyle := 2;
  2303.       MsgX1 := 1;
  2304.       MsgX2 := 80;
  2305.       MsgY := 25;
  2306.       HelpStr := ' ~F1~ Help ';
  2307.       Helpkey := 315;
  2308.    end;
  2309. end; { MenuDefaultSettings }
  2310.  
  2311. procedure GoldMenuInit;
  2312. {}
  2313. begin
  2314.    with MenuVars do
  2315.    begin
  2316.       LastECode := 0;
  2317.       EMsgFunc := MenuEMsg;
  2318.    end;
  2319.    MenuDefaultSettings;
  2320. end; {GoldMenuInit}
  2321.  
  2322. {$IFDEF TTT5} { allows backward compatibility to TTT5 }
  2323. procedure Menu_Set(var M: Menurecord);
  2324. begin
  2325.    MenuSet(M);
  2326.    with M do
  2327.    if ColorScreen then
  2328.    begin
  2329.       Colors[1]    := white;
  2330.       Colors[2]    := blue;
  2331.       Colors[3]    := black;
  2332.       Colors[4]    := lightgray;
  2333.       Colors[5]    := blue;
  2334.    end else
  2335.    begin
  2336.       Colors[1]    := white;
  2337.       Colors[2]    := black;
  2338.       Colors[3]    := lightgray;
  2339.       Colors[4]    := black;
  2340.       Colors[5]    := white;
  2341.    end;
  2342. end; {Menu_Set}
  2343.  
  2344. procedure Display_Menu(MenuDef: Menurecord; Window:Boolean; var Choice,Errorcode: integer);
  2345. {}
  2346. begin
  2347.    with MenuDef do
  2348.    begin
  2349.       Colors[5] := CAttr(Colors[5],Colors[4]);
  2350.    end;
  2351.    DisplayMenu(MenuDef,Window,Choice,Errorcode);
  2352. end; {Display_Menu}
  2353. {$ENDIF}
  2354.  
  2355. begin
  2356.    GoldMenuInit;
  2357. end.
  2358.